home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.0 / stk-3 / blt-for-STk-3.0 / blt-1.9 / demos / features.tcl < prev    next >
Encoding:
Text File  |  1995-07-01  |  6.5 KB  |  273 lines
  1.  
  2. set bindings(dummy) {}
  3.  
  4. proc bltResetBindings { graph type } {
  5.     global bindings
  6.  
  7.     set all [array names bindings] 
  8.     set cmds {}
  9.     foreach i $all {
  10.     if [string match "$type,$graph,*" $i] {
  11.         lappend cmds $bindings($i)
  12.     }
  13.     }
  14.     bind $graph $type [join $cmds \n]
  15. }
  16.  
  17. proc bltActivateLegend { graph name } {
  18.     global lastActive
  19.  
  20.     set last $lastActive($graph)
  21.     if { $name != $last } {
  22.     if { $last != "" } {
  23.         $graph legend deactivate $last
  24.         $graph element deactivate $last
  25.     }
  26.     if { $name != "" } {
  27.         $graph legend activate $name
  28.         $graph element activate $name 
  29.     }
  30.     set lastActive($graph) $name
  31.     }
  32. }
  33.  
  34. proc SetActiveLegend { graph } {
  35.     global lastActive bindings
  36.  
  37.     set lastActive($graph) {}
  38.     set bindings(<Motion>,$graph,activeLegend) {
  39.     set info [%W legend get @%x,%y]
  40.     bltActivateLegend %W $info
  41.     }    
  42.     bltResetBindings $graph <Motion>
  43. }
  44.  
  45.  
  46. proc SetCrosshairs { graph } {
  47.     global bindings
  48.     
  49.     $graph crosshairs set on 
  50.     set bindings(<Motion>,$graph,crosshairs) {
  51.     %W crosshairs configure -position @%x,%y
  52.     }
  53.     bltResetBindings $graph <Motion>
  54. }
  55.  
  56.  
  57. proc bltFindElement { graph x y } {
  58.     set info [$graph element closest $x $y ]
  59.     if { $info == "" } {
  60.     blt_bell
  61.     return
  62.     }
  63.     set name [lindex $info 0]
  64.     set points [lrange $info 2 3]
  65.     set index [lindex $info 1]
  66.     global tagId
  67.     catch { $graph tag delete $tagId($graph,$name,$index) }
  68.     set tagId($graph,$name,$index) \
  69.     [$graph tag create text $points -text " $name \[$index\] " -anchor s \
  70.      -yoffset -10 -fg black -bg {}]
  71.     bltFlashPoint $graph $name $index 10
  72. }
  73.  
  74. proc bltFlashPoint { graph name index count } {
  75.     if { $count & 1 } {
  76.         $graph element deactivate $name
  77.     } else {
  78.         $graph element activate $name $index
  79.     }
  80.     incr count -1
  81.     if { $count > 0 } {
  82.     after 200 bltFlashPoint $graph $name $index $count
  83.     update
  84.     } else {
  85.     global tagId
  86.     catch { $graph tag delete $tagId($graph,$name,$index) }
  87.     }
  88. }
  89.  
  90. proc SetClosestPoint { graph } {
  91.     global bindings
  92.  
  93.     global tagId
  94.     set tagId(dummy) {}
  95.     set bindings(<ButtonPress-3>,$graph,closestPoint) {
  96.     bltFindElement %W  %x %y
  97.     }
  98.     bltResetBindings $graph <ButtonPress-3>
  99. }
  100.  
  101.  
  102. proc bltGetCoords { graph winX winY var index } {
  103.     scan [$graph invtransform $winX $winY] "%s %s" x y 
  104.     scan [$graph xaxis limits] "%s %s" xmin xmax
  105.     scan [$graph yaxis limits] "%s %s" ymin ymax
  106.  
  107.     if { $x > $xmax } { 
  108.     set x $xmax 
  109.     } elseif { $x < $xmin } { 
  110.     set x $xmin 
  111.     }
  112.  
  113.     if { $y > $ymax } { 
  114.     set y $ymax 
  115.     } elseif { $y < $ymin } { 
  116.     set y $ymin 
  117.     }
  118.     upvar $var arr
  119.     set arr($index,x) $x
  120.     set arr($index,y) $y
  121. }
  122.  
  123.  
  124. proc bltGetAnchor { graph x y } {
  125.     global pos bindings
  126.  
  127.     set pos(B,x) {}
  128.     set pos(B,y) {}
  129.     bltGetCoords $graph $x $y pos A
  130.     set bindings(<B1-Motion>,$graph,zoom) { 
  131.     bltScan %W %x %y 
  132.     }
  133.     set bindings(<ButtonRelease-1>,$graph,zoom) { 
  134.     bltZoom %W %x %y 
  135.     }
  136.     bltResetBindings $graph <ButtonRelease-1>
  137.     bltResetBindings $graph <B1-Motion>
  138. }
  139.  
  140.  
  141. proc bltBox { graph x1 y1 x2 y2 } {
  142.     global tagId 
  143.  
  144.     set text [format "%.4g,%.4g" $x1 $y1] 
  145.     if { $tagId($graph,text1) == "" } then {
  146.     set tagId($graph,text1) \
  147.         [$graph tag create text {$x1 $y1} -text $text ] 
  148.     } else {
  149.     $graph tag configure $tagId($graph,text1) -text $text 
  150.     $graph tag coords $tagId($graph,text1) "$x1 $y1"
  151.     }
  152.     set text [format "%.4g,%.4g" $x2 $y2] 
  153.     if { $tagId($graph,text2) == "" } then {
  154.     set tagId($graph,text2) \
  155.         [$graph tag create text {$x2 $y2} -text $text ] 
  156.     } else {
  157.     $graph tag configure $tagId($graph,text2) -text $text 
  158.     $graph tag coords $tagId($graph,text2) "$x2 $y2"
  159.     }
  160.     set coords {
  161.     $x1 $y1 $x1 $y2 $x1 $y1 $x2 $y1 $x2 $y1 $x2 $y2 $x1 $y2 $x2 $y2 
  162.     }
  163.     if { $tagId($graph,outline) == "" } then {
  164.     set tagId($graph,outline) [$graph tag create line $coords]
  165.     } else {
  166.     $graph tag coords $tagId($graph,outline) $coords
  167.     }
  168. }
  169.  
  170. set pos(last,x) 0
  171. set pos(last,y) 0
  172.  
  173. proc bltScan { graph x y } {
  174.     global pos
  175.  
  176.     set deltaX [expr abs($pos(last,x)-$x)]
  177.     set deltaY [expr abs($pos(last,y)-$y)]
  178.     if { ($deltaX < 5) && ($deltaY < 5) } {
  179.     return
  180.     }    
  181.     set pos(last,x) $x
  182.     set pos(last,y) $y
  183.  
  184.     bltGetCoords $graph $x $y pos B
  185.     if { $pos(A,x) > $pos(B,x) } { 
  186.     bltBox $graph $pos(B,x) $pos(B,y) $pos(A,x) $pos(A,y)
  187.     } else {
  188.     bltBox $graph $pos(A,x) $pos(A,y) $pos(B,x) $pos(B,y)
  189.     }
  190. }
  191.  
  192. proc bltZoom { graph x y } {
  193.     global bindings pos tagId
  194.  
  195.     # Go back to original bindings
  196.     set bindings(<ButtonPress-1>,$graph,zoom) { 
  197.     bltGetAnchor %W %x %y 
  198.     }
  199.     set bindings(<B1-Motion>,$graph,zoom) {}
  200.  
  201.     catch {$graph tag delete $tagId($graph,text1) $tagId($graph,text2)}
  202.     set tagId($graph,text1) {}
  203.     set tagId($graph,text2) {}
  204.  
  205.     bltResetBindings $graph <B1-Motion>
  206.     bltResetBindings $graph <ButtonPress-1>
  207.  
  208.     if { $pos(B,x) == "" } then {
  209.     catch {$graph tag delete $tagId($graph,outline)}
  210.     set tagId($graph,outline) {} 
  211.     $graph xaxis configure -min {} -max {} 
  212.     $graph yaxis configure -min {} -max {}
  213.     return
  214.     }
  215.     if { $pos(A,x) > $pos(B,x) } { 
  216.     $graph xaxis configure -min $pos(B,x) -max $pos(A,x) 
  217.     } else { 
  218.     if { $pos(A,x) < $pos(B,x) } {
  219.         $graph xaxis configure -min $pos(A,x) -max $pos(B,x) 
  220.     }
  221.     }
  222.     if { $pos(A,y) > $pos(B,y) } { 
  223.     $graph yaxis configure -min $pos(B,y) -max $pos(A,y)
  224.     } else {
  225.     if { $pos(A,y) < $pos(B,y) } {
  226.         $graph yaxis configure -min $pos(A,y) -max $pos(B,y)
  227.     }
  228.     }
  229. #    $graph configure -cursor crosshair 
  230.     catch {$graph tag delete $tagId($graph,outline)}
  231.     set tagId($graph,outline) {}
  232.     blt_busy hold $graph
  233.     update
  234.     blt_busy release $graph
  235. }
  236.  
  237.  
  238. proc SetZoom { graph } {
  239.     global bindings tagId
  240.  
  241.     set tagId($graph,text1) {}
  242.     set tagId($graph,text2) {}
  243.     set tagId($graph,outline) {}
  244.     set bindings(<ButtonRelease-2>,$graph,zoom) {
  245.     catch {%W tag delete $tagId(outline) }
  246.     set tagId(outline) {} 
  247.     %W yaxis configure -min {} -max {} 
  248.     %W xaxis configure -min {} -max {}
  249.     blt_busy hold %W
  250.     update
  251.     blt_busy release %W
  252.     }
  253.     set bindings(<ButtonPress-1>,$graph,zoom) { 
  254. #       %W configure -cursor {crosshair red black}
  255.     bltGetAnchor %W %x %y 
  256.     bltScan %W %x %y 
  257.     }
  258.     bltResetBindings $graph <ButtonPress-1>
  259.     bltResetBindings $graph <ButtonRelease-2>
  260. }
  261.  
  262. proc SetPrint { graph } {
  263.     global bindings
  264.     set bindings(<Shift-ButtonRelease-3>,$graph,print) {
  265.     puts stdout "creating file \"out.ps\... " nonewline
  266.     flush stdout
  267.     %W postscript "out.ps" -pagewidth 6.5i -pageheight 8.5i -landscape true
  268.     puts stdout "done."
  269.     flush stdout
  270.     }
  271.     bltResetBindings $graph <Shift-ButtonRelease-3>
  272. }
  273.